home *** CD-ROM | disk | FTP | other *** search
- /*********************************************************/
- /* */
- /* PISTOL-Portably Implemented Stack Oriented Language */
- /* Version 2.0 */
- /* (C) 1983 by Ernest E. Bergmann */
- /* Physics, Building #16 */
- /* Lehigh Univerisity */
- /* Bethlehem, Pa. 18015 */
- /* */
- /* Permission is hereby granted for all reproduction and */
- /* distribution of this material provided this notice is */
- /* included. */
- /* */
- /*********************************************************/
- /* second module for PISTOL v2.0 in BDS 'C', v1.45a */
- /* August 30, 1982 */
- #include "bdscio.h"
- #include "pistol.h"
-
- ttyi() /* inputs character from keyboard, buffered by line */
- { /* static char keycurs,keylen,keystring[MAXORD]; */
- if(keycurs>keylen)
- {keylen=strlen(gets(keystring));
- if(ram[8].in)
- {fputs(keystring,list);
- fputs("\n",list);
- }
- keycurs=0;
- keystring[keylen]=NEWLINE;
- }
- push(keystring[keycurs++]);
- }
-
- pop()
- { if(stkptr<1) merr(undflo);
- else return(stack[stkptr--]);
- }
-
- carret()
- { if(ram[10].in)
- {if(ram[17].in==++ram[18].in)
- {ttyi();ram[18].in=0;
- if('Q'==toupper(pop()) ) abort();
- }
- ram[20].in=0;
- printf("\n");
- }
- if(ram[8].in) fprintf(list,"\n");
- }
-
- spaces(num)
- char num;
- { while(num) { chout(' '); num-- ; }
- }
-
- tab()
- { if(ram[23].cr)
- spaces(ram[23].cr-ram[20].in%ram[23].cr);
- }
-
- chout(ch)
- char ch;
- { if(ch==NEWLINE) carret();
- else if (ch==9) tab();
- else { if(ram[20].in==ram[19].in) carret();
- ram[20].in++;
- if(ram[10].in) putc(ch,1);
- if(ram[8].in)putc(ch,list);
- }
- }
-
- message(st)
- char *st;
- {char *last;
- char len;
- len=*st;
- last=st + *st;
- while(st < last){st++; chout(*st);}
- }
-
-
- interpret()
- { do {ip += W;
- if(instr<NFUNCS) (*farray[instr])();
- else {if((instr<&ram)||(instr>&ram[RAMSIZE]))
- merr(readv);
- rpush(ip); ip=instr;
- }
- Pw = ip;
- instr=*Pw;
- /* trace patch here */
- if(rptr==(ram[15].in-2))
- {savinstr=instr;
- savlevel=rptr;
- instr=ram[22].in;
- ip -= W;
- do {ip += W;
- if(instr<NFUNCS)
- (*farray[instr])();
- else {
- if((instr<&ram)||
- (instr>&ram[RAMSIZE]))
- merr(readv);
- rpush(ip); ip=instr;
- }
- Pw=ip; instr=*Pw;
- }
- while( rptr > savlevel);
- instr=savinstr;
- }
- }
- while (rptr >= 0);
- ip -= W;
- }
-
- merr(m)
- char *m;
- { ram[10].in=TRU;
- if(ram[20].in) carret();
- message(m);
- abort();
- }
-
- synterr()
- {ram[10].in=TRU;if(ram[20].in)carret();
- if((ram[7].in) && (ram[9].in==FALS))
- message(&strings[LINEBUF]);
- merr(synt);
- }
-
- push(item)
- int item;
- { if(++stkptr >= SSIZE) merr(ovflo);
- stack[stkptr]=item;
- }
-
- rpush(item)
- int item;
- { if(++rptr >= RSIZE) merr(ovflo);
- rstack[rptr]=item;
- }
-
-
- lpush(item)
- int item;
- {if(LSIZE<= ++lptr) merr(ovflo); lstack[lptr]=item;}
-
- cpush(item)
- int item;
- {if(CSIZE<= ++cptr) merr(ovflo); cstack[cptr]=item; }
-
-
- pushck(chkch)
- char chkch;
- { if(CHKLMT>(++strings[1])) strings[1+strings[1]]=chkch;
- else{ram[10].in=TRU; message(ovflo); synterr();}
- }
-
- append(item) /* place item at end of dictionary */
- int item;
- {
- (*ram[2].pw).in=item;
- ram[2].pw++;
- if( ram[2].pw>=&ram[COMPBUF] ) merr(writv);
- }
-
- aloop()
- {if(lstack[lptr]<lstack[lptr-1]){Pw=ip;ip += *Pw; }
- else{lptr -=3; if(lptr<0) merr(undflo); ip +=W ; }
- }
-
- pdo()
- {/* static int start,nd; */
- start=pop(); nd=pop();
- if(start<nd)
- {lpush(start);
- lpush(nd);
- lpush(start);/* init iteration var.*/
- ip += W;
- }
- else {Pw=ip; ip += *Pw ; }
- }
-
-
- dropck()
- {if(strings[1]) strings[1]--; else synterr(); }
-
-
- int *vfind()/*??? cleanup variable names and static*/
- {char *str2;
- /*ptoken,vloc,vmatch,prev,pcount,*Pc3 are "static"*/
- vloc=pop(); prev=vloc=*vloc;
- ptoken=pop();
- if((ptoken<&strings)||(ptoken>=&strings[LINEBUF]))
- merr(readv);
- if(vloc) do
- {vmatch=TRU;
- if(Pw=*(vloc-2),*Pw==*ptoken)
- for(Pc3=Pw,vmatch=*Pc3,str2=ptoken;
- vmatch&&(*++Pc3 == *++str2) ; --vmatch);
- if(vmatch)
- {prev=vloc;vloc=*(vloc-3);}
- }
- while(vloc && vmatch);
- push(vloc);
- ram[6].pw=prev;
- }
-
- find()
- {int *ptoken,*loc,*v;
- ptoken=pop();
- for(loc=FALS,v=ram[28].pw;(v>=&ram[VBASE])&& !loc; v--)
- {push(ptoken);push(*v);vfind();loc=pop();}
- push(loc);
- }
-
- enter()
- {int ptoken;
- ptoken=stack[stkptr];
- find();
- if(pop())
- {message(redef);
- spaces(3);
- message(ptoken);
- carret();
- }
- append(0);
- append((*ram[5].pw).in);
- append(ptoken);
- append(COMPHERE);
- (*ram[5].pw).in=ram[2].in;
- }
-
- fenter()
- {Pw=(*ram[5].pw).pw-4; *Pw=pop(); }
-
- geoln()
- {ram[11].pc=&strings[LINEBUF]+strings[LINEBUF];}
-
- getline()
- {if(ram[7].in) finline(ldfil);
- else cinline();
- if(ram[9].in&&ram[7].in) message(&strings[LINEBUF]);
- }
-
-
- cinline() /*input line from console*/
- { keycurs=1+keylen; /* for emptying ttyi() buffer */
- ram[11].pc=&strings[LINEBUF+1];
- ram[12].in=1+strlen(gets(&strings[LINEBUF+1]));
- Pc=&strings[LINEBUF];
- *Pc=ram[12].in;
- Pc += ram[12].in;
- *Pc=NEWLINE; Pc++ ;
- *Pc = 0;/* for 'C' string terminator*/
- if(ram[8].in)fputs(ram[11].pc,list);
- }
-
- finline(iobuf)
- char *iobuf;
- { ram[11].pc=fgets(&strings[LINEBUF+1],iobuf);
- if(!ram[11].in) merr(feof);
- ram[12].in=strlen(ram[11].pc);
- Pc=&strings[LINEBUF];
- *Pc=ram[12].in;
- Pc += ram[12].in;
- *Pc=NEWLINE; Pc++ ;
- *Pc=0 ; /*???? should echo to list? */
- if(ram[8].in&&ram[9].in)fputs(ram[11].pc,list);
- }
-
- ret();
- }
- append(0);
- append((*ram[5].pw).in);
- app